home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue67 / System / DeskApp / fmMain.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2001-02-06  |  2.4 KB  |  99 lines
  1. unit fmMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Save: TButton;
  12.     Restore: TButton;
  13.     procedure FormCreate(Sender: TObject);
  14.     procedure FormDestroy(Sender: TObject);
  15.     procedure SaveClick(Sender: TObject);
  16.     procedure RestoreClick(Sender: TObject);
  17.   private
  18.     { Private declarations }
  19.     hDIPSLib: hModule;
  20.     hDeskWin: hWnd;
  21.     function SetDIPSHook (ThreadID: DWord): Boolean;
  22.   public
  23.     { Public declarations }
  24.   end;
  25.  
  26. var
  27.   Form1: TForm1;
  28.  
  29. implementation
  30.  
  31. {$R *.DFM}
  32.  
  33. uses CommCtrl;
  34.  
  35. // Get a window to the ListView control which implements the desktop
  36.  
  37. function GetDesktopListView: HWnd;
  38. var
  39.     buff: array [0..255] of Char;
  40. begin
  41.     Result := GetWindow (GetWindow (FindWindow ('ProgMan', Nil),
  42.                          gw_Child), gw_Child);
  43.  
  44.     if Result <> 0 then begin
  45.         GetClassName (Result, buff, sizeof (buff));
  46.         if buff <> 'SysListView32' then Result := 0;
  47.     end;
  48.  
  49.     if Result = 0 then raise Exception.Create ('Desktop ListView control not found');
  50. end;
  51.  
  52. function GetDesktopThread: DWord;
  53. begin
  54.     Result := GetWindowThreadProcessID (GetDesktopListView, Nil);
  55. end;
  56.  
  57. function TForm1.SetDIPSHook (ThreadID: DWord): Boolean;
  58. type
  59.     SetDIPSHook = function (ThreadID: DWord): Bool; stdcall;
  60. var
  61.     proc: SetDIPSHook;
  62. begin
  63.     Result := False;
  64.     proc := GetProcAddress (hDIPSLib, '_SetDIPSHook@4');
  65.     if @proc <> Nil then Result := proc (ThreadID);
  66. end;
  67.  
  68. procedure TForm1.FormCreate(Sender: TObject);
  69. var
  70.     Msg: TMsg;
  71. begin
  72.     hDIPSLib := LoadLibrary ('DIPSLIB.DLL');
  73.     if hDIPSLib = 0 then raise Exception.Create ('Can''t find DLL!');
  74.     SetDIPSHook (GetDesktopThread);
  75.     GetMessage (Msg, 0, 0, 0);
  76.     hDeskWin := FindWindow (Nil, 'Delphi Desktop 2001');
  77.     if hDeskWin = 0 then raise Exception.Create ('Trouble at ''mill');
  78. end;
  79.  
  80. procedure TForm1.FormDestroy(Sender: TObject);
  81. begin
  82.     SendMessage (hDeskWin, wm_Close, 0, 0);
  83.     while IsWindow (hDeskWin) do Application.ProcessMessages;
  84.     SetDIPSHook (0);
  85.     FreeLibrary (hDIPSLib);
  86. end;
  87.  
  88. procedure TForm1.SaveClick(Sender: TObject);
  89. begin
  90.     SendMessage (hDeskWin, wm_App, GetDesktopListView, 1);
  91. end;
  92.  
  93. procedure TForm1.RestoreClick(Sender: TObject);
  94. begin
  95.     SendMessage (hDeskWin, wm_App, GetDesktopListView, 0);
  96. end;
  97.  
  98. end.
  99.